home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
4cmp22s.zip
/
DOS2.4TH
< prev
next >
Wrap
Text File
|
1994-10-30
|
5KB
|
113 lines
\ DOSINT FILE INTERFACE
\ Code Copyright (C) 1986 by Thomas Almy. All rights reserved.
\ Permission is granted to registered users of ForthCMP to sell or distribute
\ computer programs incorporating the compiled contents of this file.
\ This file is intended to behave like UR/FORTH's "DOSINT"
\ interface. There are some differences (such as "closed" in the level
\ two functions being -1 so as not to interfere with standard input.
\ This file must be included after the application, just before
\ "FORTHLIB". the file "DOS1" should be included before the application.
\ Enjoy!
\ Tom
10 DECIMAL .( Loading DOS2) CR
\ Erzatz String Support
FIND STRBUF [IF] DROP ( good news ) [ELSE] ( fake it )
DSEG
CREATE sB1 80 ALLOT CREATE sB2 80 ALLOT
VARIABLE sBSW sB1 sBSW !
1 1 IN/OUT
: ASCIIZ COUNT >R
sBSW @ sB1 sB2 XOR XOR DUP sBSW !
R@ CMOVE
R> sBSW @ + 0 C<-
sBSW @ ; [THEN]
U: .FNAME CELL+ COUNT TYPE ;
U: HCB>N CELL+ ;
U: HCB>H @ ;
U: NAME>HCB DUP FCLOSE DROP CELL+ OVER C@ 1+ CMOVE ;
U: FMAKE OVER DUP @ 0< 0= IF 2DROP DROP -1 EXIT THEN
CELL+ SWAP creat DUP -1 = IF NIP EXIT THEN <- 0 ;
U: FOPEN OVER DUP @ 0< 0= IF 2DROP DROP -1 EXIT THEN
CELL+ SWAP open DUP -1 = IF NIP EXIT THEN <- 0 ;
UNDEF open CODE open SI POP BX POP AX POP BX PUSH SI PUSH
CALL' ASCIIZ SI POP AX DX MOV AX POP
61 # AH MOV 33 INT ( ' seterr JMP ) END-CODE [THEN]
L: seterr <U ~ IF, 0 # errno [] MOV ELSE, AX errno [] MOV
-1 # AX MOV THEN, AX PUSH SI JMP END-CODE
L: retstat <U ~ IF, AX AX XOR AX errno [] MOV ELSE,
AX errno [] MOV -1 # AX MOV THEN, AX PUSH SI JMP END-CODE
UNDEF creat CODE creat SI POP BX POP AX POP BX PUSH SI PUSH
CALL' ASCIIZ SI POP AX DX MOV CX POP
60 # AH MOV 33 INT seterr JMP END-CODE [THEN]
U: FSEEK >R >R >R @ R> R> R> 3 PICK 0< 0= IF lseek EXIT THEN 2DROP 2DROP -1. ;
UNDEF lseek
CODE lseek SI POP AX POP CX POP DX POP BX POP
66 # AH MOV 33 INT <U IF, AX errno [] MOV
-1 # AX MOV AX PUSH AX PUSH SI JMP THEN,
0 # errno [] MOV AX PUSH DX PUSH SI JMP END-CODE [THEN]
U: FDEL DUP @ 0< 0= IF DROP -1 EXIT THEN CELL+ unlink ;
UNDEF unlink
CODE unlink SI POP AX POP SI PUSH CALL' ASCIIZ SI POP
AX DX MOV 65 # AH MOV 33 INT retstat JMP END-CODE [THEN]
U: FREAD ROT @ ?opn IF -ROT ?DS: -ROT 63 r/w EXIT THEN
2DROP 0 ;
U: FWRITE ROT @ ?opn IF -ROT ?DS: -ROT 64 r/w EXIT THEN
2DROP 0 ;
U: FREADL >R ROT @ ?opn IF -ROT R> 63 r/w EXIT THEN R> DROP 2DROP 0 ;
U: FWRITEL >R ROT @ ?opn IF -ROT R> 64 r/w EXIT THEN R> DROP 2DROP 0 ;
U: readl 63 r/w ;
U: read ?DS: -ROT 63 r/w ;
U: writel 64 r/w ;
U: write ?DS: -ROT 64 r/w ;
UNDEF r/w CODE r/w ( handle seg buf len command -- results.. )
SI POP AX POP AL AH MOV CX POP DX POP DI DS <SEG
DS POPSEG BX POP 33 INT DI DS >SEG
<U ~ IF, 0 # errno [] MOV ELSE, AX errno [] MOV
AX AX XOR THEN, AX PUSH SI JMP END-CODE [THEN]
U: FCLOSE DUP @ ?opn IF close ELSE -1 THEN SWAP ON ;
PRIMITIVE U: ?opn DUP 0< IF DROP 0 ELSE -1 THEN ;
UNDEF close CODE close SI POP BX POP 62 # AH MOV
33 INT retstat JMP END-CODE [THEN]
UNDEF chmod CODE chmod SI POP CX POP AX POP CX PUSH SI PUSH
CALL' ASCIIZ AX DX MOV SI POP CX POP -1 # CX CMP
=0 IF, HEX 4300 # AX MOV ELSE, 4301 # AX MOV THEN, DECIMAL
33 INT <U ~ IF, 0 # errno [] MOV CX PUSH SI JMP THEN,
AX errno [] MOV -1 # AX MOV AX PUSH SI JMP END-CODE [THEN]
U: FREN OVER @ OVER @ AND 0< IF 2DROP -1 EXIT THEN
CELL+ SWAP CELL+ SWAP rename ;
UNDEF rename CODE rename SI POP AX POP SI PUSH CALL' ASCIIZ
SI POP AX BX MOV AX POP SI PUSH BX PUSH CALL' ASCIIZ
AX DX MOV DI POP SI POP DS PUSHSEG ES POPSEG
86 # AH MOV 33 INT retstat JMP END-CODE [THEN]
U: FCHDIR DUP @ 0< 0= IF DROP -1 EXIT THEN CELL+ chdir ;
U: FMKDIR DUP @ 0< 0= IF DROP -1 EXIT THEN CELL+ mkdir ;
U: FRMDIR DUP @ 0< 0= IF DROP -1 EXIT THEN CELL+ rmdir ;
?DEFINE chdir ?DEFINE mkdir ?DEFINE rmdir OR OR [IF]
L: dircmd SI POP AX POP BX PUSH SI PUSH CALL' ASCIIZ
SI POP AX DX MOV AX POP 33 INT retstat JMP END-CODE [THEN]
UNDEF chdir CODE chdir 59 # BH MOV dircmd JMP END-CODE [THEN]
UNDEF mkdir CODE mkdir 57 # BH MOV dircmd JMP END-CODE [THEN]
UNDEF rmdir CODE rmdir 58 # BH MOV dircmd JMP END-CODE [THEN]
UNDEF getdir
1 0 IN/OUT CODE (getdir) AX SI MOV 0 # DL MOV 71 # AH MOV
33 INT RET END-CODE
FIND STRBUF [IF] DROP
: getdir 64 +STRBUF STRBUF (getdir) STRBUF -ASCIIZ ; [ELSE]
: getdir sB1 1+ (getdir) sB1 1+ 64 0 SCAN DROP sB1 1+ -
sB1 C! sB1 ; [THEN] [THEN]
UNDEF firstf CODE firstf SI POP BX POP AX POP BX PUSH SI PUSH
CALL' ASCIIZ SI POP CX POP AX DX MOV 78 # AH MOV 33 INT
retstat JMP END-CODE [THEN]
UNDEF nextf CODE nextf SI POP 79 # AH MOV 33 INT retstat JMP
END-CODE [THEN]
16 = [IF] HEX [THEN]